0 .if

SpeechToy?  9 years later?????   Yep.

I thought it would be a kick for it to re-emerge as JForth source
and executable!   (Ok, maybe I need to get out more.)

I've included the original C source code, in case you might
like to compare them.  JForth is really very easy to port to
from C.

And thanks, Dave M Lucas.  I suppose that if you weren't before,
you are now, an official pioneer!

In this JForth version, I added the 2.0 colors, shaded gadgets and 
the LOOP Button.  Other than that, it's a true & faithful port.

Anyway, hope everyone gets some enjoyment out of this, at least
as much as I did converting it to JForth!  I especially
laughed at the very first paragraph below!

- Mike Haas
mikeh@starnine.com

3867 La Colina Rd.
El Sobrante, CA. 94803

So here it is, Speechtoy, all new and yet the same, but guarenteed
Forthified!

AND... still public domain!   Take it away, Dave...

/* !!! To those who haven't figured it out yet:
 * !!! set stack to 15000 before compiling.      <- not in JForth!!! :-)
 * !!! This is a generally good thing to do if
 * !!! the compiler blows up on a large source.            <-!!! ??? !!!
 * !!! if your program suddenly KILLS the compiler,
 * !!! increase stack by 5K and try again. jeeze you guys. <-!!! ??? !!!
 */
/* This program was written to show the use of gadgets in a
 * window. Thus one menu, one auto requester, but lots of
 * gadget types.
 * For the sake of example, two mutual exclude gadgets
 * (female/male) are shown that perform a function that might
 * be better implemented as a toggle image, in a manner similar
 * to that shown in the inflection Mode gadget.
 * Again for the sake of example, the proportional gadgets
 * are generated dynamicly (that is, copied from a template and
 * filled in)n whereas most gadgets are declared staticly in
 * the struct declaration, which saves the initialization code
 * space.
 * Lastly, for the sake of example, this program is extremely
 * verbose in the way of comments. Hope you don't mind.
 */
/* Written by David M Lucas. */
/* If you find somthing you don't like, fix it! Have fun! */
/* Send complaints to /dev/null. really. */
/* Thanks Amiga. */
.then

getmodule includes

0 .IF
#include "exec/types.h"
#include "exec/exec.h"
#include "intuition/intuition.h"
#include "intuition/intuitionbase.h"
#include "graphics/regions.h"
#include "graphics/copper.h"
#include "graphics/gels.h"
#include "graphics/gfxbase.h"
#include "devices/keymap.h"
#include "hardware/blit.h"
#include "devices/narrator.h"
#include "libraries/translator.h"
.THEN

include? goto.error ju:goto_error  \ this came in VERY handy in one place
                                   \ nice to have for porting from C

anew task-SpeechToy.f

\ All needed Amiga support words, so we don't have to compile
\ the ju: files for just these...

asm NewList()   ( &list -- )
    move.l  tos,a0
    adda.l  org,a0
    \
    move.l  a0,[lh_tailpred](a0)
    addq.l  #4,a0	;get address of lh_tail
    clr.l   (a0)	;clear lh_tail
    move.l  a0,-(a0)	;address of lh_tail to lh_head
    \
    move.l  (dsp)+,tos
    forth{  BOTH  }
end-code

: OpenWindow() ( newwindow -- wdw/0 )
  call>abs intuition_lib OpenWindow if>rel  ;
 
: CloseWindow() ( window -- )
  callvoid>abs intuition_lib CloseWindow  ;
 
: AllocSignal() ( signal -- sigbit )
  call exec_lib AllocSignal  ;
 
: FreeSignal() ( sigbit -- )
  callvoid exec_lib FreeSignal  ;
 
: FindTask() ( 0name -- task )
  call exec_lib FindTask if>rel  ;
 
: SetAPen() ( rport pen -- )
  callvoid>abs graphics_lib SetAPen  ;
 
: RectFill() ( rport l t w h -- )
  callvoid>abs graphics_lib RectFill  ;
 
: Move() ( rport x y -- )
  callvoid>abs graphics_lib Move  ;
 
: Draw() ( rport x y -- )
  callvoid>abs graphics_lib Draw  ;
 
: RefreshGadgets() ( gadget window screen? -- )
  callvoid>abs intuition_lib RefreshGadgets  ;

: SetMenuStrip()   ( ControlWindow &MyMenu -- )
  callvoid>abs intuition_lib SetMenuStrip  ;

: Wait()   ( mask -- signals )
  call exec_lib Wait  ;

: GetMsg() ( port -- msg )
  call>abs exec_lib GetMsg if>rel  ;

: ReplyMsg()  ( msg -- )
  callvoid>abs exec_lib ReplyMsg  ;

: DisplayBeep()  ( scr -- )
  callvoid>abs intuition_lib DisplayBeep  ;

: RemoveGadget()  ( win gad -- pos )
  call>abs intuition_lib RemoveGadget  ;

: OnGadget()  ( gad win scr -- )
  callvoid>abs intuition_lib OnGadget  ;

: OffGadget()  ( gad win scr -- )
  callvoid>abs intuition_lib OffGadget  ;

: AddGadget()  ( win gad pos -- )
  callvoid>abs intuition_lib AddGadget  ;

: WaitBOVP()  ( viewport -- )
  callvoid>abs graphics_lib WaitBOVP  ;

: SendIO()  ( ioreq -- )
  callvoid>abs exec_lib SendIO  ;
  
: AbortIO()  ( ioreq -- )
  callvoid>abs exec_lib AbortIO  ;
  
: AutoRequest()  ( win body yText nText pFlag nFlag wid hght -- response )
  call>abs intuition_lib AutoRequest  ;
  
: Translate()  ( inbuf inlen outbuf outlen -- err )
  call>abs translator_lib Translate  ;

: AllocMem()  ( size type -- mem )
  call exec_lib AllocMem if>rel  ;

: FreeMem()  ( mem size -- )
  callvoid>abs exec_lib FreeMem  ;

: MENUNUM() ( menucode -- menu# )
    $ 1F AND  ;

: ITEMNUM() ( menucode -- item# )
    -5 ashift  $ 3F AND  ;

\ : 4*  cells inline ;

: >>  negate ashift ;


\ seems to work, so...
\ : STDEBUG ;


321 CONSTANT CONTWINDW  \  /* Overall Control Window Width/Height */
123 CONSTANT CONTWINDH  \ 
32 CONSTANT FACEWINDW  \   /* Overall Face Window Width / Height */
44 CONSTANT FACEWINDH  \   /* this includes borders, incedently */

\ /* Pen numbers to draw gadget borders/images/text with */
3 CONSTANT REDP  \           /* color in register 3 once was red */
2 CONSTANT WHTP  \           /* color in register 2 was black */
1 CONSTANT BLKP  \           /* color in register 1 was white */
0 CONSTANT GRYP  \           /* color in register 0 was blue */

\ /* the length of the English and phonetic buffers */
512 CONSTANT ESTRINGSIZE  \ 
768 CONSTANT PSTRINGSIZE  \  /* phonemes are longer than english */

4 CONSTANT NUMPROPS  \       /* number of proportional gadgets */

\ /* Ranges of proportional data */
   MAXFREQ   MINFREQ  - 1+  CONSTANT RNGFREQ
   MAXRATE   MINRATE  - 1+  CONSTANT RNGRATE
   MAXPITCH  MINPITCH - 1+  CONSTANT RNGPITCH
   MAXVOL    MINVOL   - 1+  CONSTANT RNGVOL

defer Initialize

: Initialize1 ;


TextAttr TestFont
   TOPAZ_EIGHTY TestFont s! ta_YSize
   0 TestFont s! ta_Style
   0 TestFont s! ta_Flags

: Initialize2  ( -- )  Initialize1
  0" topaz.font" TestFont s! ta_Name
;


\ /* Which audio channels to use */
4 CARRAY audio_chan
     3 0 audio_chan c!
     5 1 audio_chan c!
    10 2 audio_chan c!
    12 3 audio_chan c!

\ /* Pointer to translator library vectors */
\ value TranslatorBase   TranslatorBase off

MsgPort talk_port     \ Message port for the say's I/O  */
MsgPort read_port     \ Message port for the say's I/O  */
mouth_rb mouth_io     \ IO Request block, mouth flavor */

\ /* IO Request block, narrator flavor */
narrator_rb voice_io
\ /* indicative of the Open return */
-1 value NarratorOpenError   -1 -> NarratorOpenError		\ /* not yet opened */
\ /* indicative of a Translations success */
0 value TranslatorError

0 value NarratorVersion

: Initialize3 Initialize2
   -1 -> NarratorOpenError		\ /* not yet opened */
    0 -> TranslatorError
;

0 value ii

\ /* These are used to draw the eyes and mouth size relative */
0 value MouthWMult
0 value EyesLeft
0 value MouthHMult
0 value EyesTop
0 value EyesBottom
0 value YMouthCenter  \ /* Pixels from top edge */
0 value XMouthCenter  \ /* Pixels from left edge */
0 value yaw
0 value LipWidth
0 value LipHeight

0 .if
/* String Gadgets *********************************************
 * First the string gadgets.
 * 1) because the Phonetic string is refreshed programaticly
 * (that is, deleted and added again) quite often, and doing
 * this requires the use of RefreshGadgets(), and this causes
 * gadgets that are closer to the beginning of the list than
 * the gadget given to RefreshGadgets() to flicker.
 * 2) because they don't flicker when OTHER gadgets
 * (ie female/male, coming up) are deleted and added.
 */
/* These'll be used to put a nice double line border around
 * each of the two string gadgets.
 */
/* y,x pairs drawn as a connected line. Be sure to have an even
 * number of arguments (ie complete pairs).
 */
.then

create StrVectorsLT

   0 w,  14 w,    0 w,   0 w,   297 w,  0 w,   296 w,   1 w,
   1 w,   1 w,    1 w,  13 w,
   
   
create StrVectorsBR

   1 w,  14 w,   297 w, 14 w,    297 w, 1 w,   296 w,   2 w,
 296 w,  13 w,     2 w, 13 w,
   
Border StrBorderLT

  -4 StrBorderLT s! bd_LeftEdge
  -3 StrBorderLT s! bd_TopEdge
BLKP StrBorderLT s! bd_FrontPen
GRYP StrBorderLT s! bd_BackPen
JAM1 StrBorderLT s! bd_DrawMode
   6 StrBorderLT s! bd_Count
   0 StrBorderLT s! bd_NextBorder

Border StrBorder

  -4 StrBorder s! bd_LeftEdge
  -3 StrBorder s! bd_TopEdge
WHTP StrBorder s! bd_FrontPen
GRYP StrBorder s! bd_BackPen
JAM1 StrBorder s! bd_DrawMode
   6 StrBorder s! bd_Count
   0 StrBorder s! bd_NextBorder

: Initialize4  ( -- )  Initialize3
  StrVectorsLT  StrBorderLT s! bd_XY
  StrVectorsBR  StrBorder   s! bd_XY
  0             StrBorderLT s! bd_NextBorder
  StrBorderLT   StrBorder   s! bd_NextBorder
;


\ /* The same undo buffer is used for both string gadgets,
\  * this is sized to largest so that largest fits.
\  */

create UndoBuffer   PSTRINGSIZE allot  here even-up dp !
UndoBuffer  here UndoBuffer -  cell- erase

\ /* English String Gadget is where the user types in English */
\ /* default text */
create EnglBuffer   ESTRINGSIZE allot  here even-up dp !
EnglBuffer  here EnglBuffer -  cell- erase

0" This is amiga speaking." 0count 1+  EnglBuffer  swap move

StringInfo EnglInfo

	          0 EnglInfo s! si_BufferPos
	ESTRINGSIZE EnglInfo s! si_MaxChars
	          0 EnglInfo s! si_DispPos
	          0 EnglInfo s! si_UndoPos
	         24 EnglInfo s! si_NumChars
	          0 EnglInfo s! si_DispCount
	          0 EnglInfo s! si_CLeft
	          0 EnglInfo s! si_CTop
	          0 EnglInfo s! si_Extension
	          0 EnglInfo s! si_LongInt
	          0 EnglInfo s! si_AltKeyMap

: Initialize5  ( -- )  Initialize4
	EnglBuffer EnglInfo s! si_Buffer
	UndoBuffer EnglInfo s! si_UndoBuffer
;


IntuiText EnglText

	BLKP EnglText s! it_FrontPen
	GRYP EnglText s! it_BackPen
	JAM1 EnglText s! it_DrawMode
	   0 EnglText s! it_LeftEdge
	 -13 EnglText s! it_TopEdge
	   0 EnglText s! it_NextText

: Initialize6  ( -- )  Initialize5
	TestFont     EnglText s! it_ITextFont
	0" English:" EnglText s! it_IText
;



Gadget EnglStrGadget

	           0 EnglStrGadget s! gg_NextGadget
	          11 EnglStrGadget s! gg_LeftEdge
	          63 EnglStrGadget s! gg_TopEdge
	         290 EnglStrGadget s! gg_Width
	          10 EnglStrGadget s! gg_Height
	   GADGHCOMP EnglStrGadget s! gg_Flags
	   RELVERIFY EnglStrGadget s! gg_Activation
	   STRGADGET EnglStrGadget s! gg_GadgetType
	           0 EnglStrGadget s! gg_SelectRender
	           0 EnglStrGadget s! gg_MutualExclude
	           0 EnglStrGadget s! gg_GadgetID
	           0 EnglStrGadget s! gg_UserData

: Initialize7  ( -- )  Initialize6
	StrBorder EnglStrGadget s! gg_GadgetRender
	EnglText  EnglStrGadget s! gg_GadgetText
	EnglInfo  EnglStrGadget s! gg_SpecialInfo
;




\ /* Phonetic string gadget is where the program puts the
\  * translated string, necessating a call to RefreshGadgets(),
\  * and is where the user can type in Phonemes.
\  */

create PhonBuffer    PSTRINGSIZE allot  here even-up dp !
  0" DHIHS IHZ AHMIY3GAH SPIY4KIHNX." 0count 1+  PhonBuffer swap move



StringInfo PhonInfo

	          0 PhonInfo s! si_BufferPos
	PSTRINGSIZE PhonInfo s! si_MaxChars
	          0 PhonInfo s! si_DispPos
	          0 PhonInfo s! si_UndoPos
	         32 PhonInfo s! si_NumChars
	          0 PhonInfo s! si_DispCount
	          0 PhonInfo s! si_CLeft
	          0 PhonInfo s! si_CTop
	          0 PhonInfo s! si_Extension
	          0 PhonInfo s! si_LongInt
	          0 PhonInfo s! si_AltKeyMap

: Initialize8  ( -- )  Initialize7
	PhonBuffer PhonInfo s! si_Buffer
	UndoBuffer PhonInfo s! si_UndoBuffer
;


IntuiText PhonText

	BLKP PhonText s! it_FrontPen
	GRYP PhonText s! it_BackPen
	JAM1 PhonText s! it_DrawMode
	   0 PhonText s! it_LeftEdge
	 -13 PhonText s! it_TopEdge
	   0 PhonText s! it_NextText

: Initialize9  ( -- )  Initialize8
	TestFont       PhonText s! it_ITextFont
	0" Phonetics:" PhonText s! it_IText
;


Gadget PhonStrGadget

	           0 PhonStrGadget s! gg_NextGadget
	          11 PhonStrGadget s! gg_LeftEdge
	          94 PhonStrGadget s! gg_TopEdge
	         290 PhonStrGadget s! gg_Width
	          10 PhonStrGadget s! gg_Height
	   GADGHCOMP PhonStrGadget s! gg_Flags
	   RELVERIFY PhonStrGadget s! gg_Activation
	   STRGADGET PhonStrGadget s! gg_GadgetType
	           0 PhonStrGadget s! gg_SelectRender
	           0 PhonStrGadget s! gg_MutualExclude
	           0 PhonStrGadget s! gg_GadgetID
	           0 PhonStrGadget s! gg_UserData

: Initialize10  ( -- )  Initialize9
	EnglStrGadget PhonStrGadget s! gg_Nextgadget
	StrBorder     PhonStrGadget s! gg_GadgetRender
	PhonText      PhonStrGadget s! gg_GadgetText
	PhonInfo      PhonStrGadget s! gg_SpecialInfo
;

\ /* Now come the Boolean Gadgets.
\  * The female/male pair shows the simplest implementation I
\  * could think of to show how you can do mutual-exclude type
\  * things yourself. They are two toggle gadgets that use
\  * highlight image. The program starts with one selected, and
\  * then if either of them are hit, both toggle. Gadgets must
\  * be deleted and added whenever you want to change structure
\  * member values that intuition expects to be coming from the
\  * user, not a program (like the SELECTED bit in flags). Note
\  * that certain structure values CAN be changed programaticly
\  * without all this broohaha. Haha. Consult the intuition
\  * manual.
\  */
\ /* Female Toggle (Highlight Image)
\    (Quasi mutual exclude with Male Toggle) */

Image FemaleImage

	 0 FemaleImage s! ig_LeftEdge
	 0 FemaleImage s! ig_TopEdge
	20 FemaleImage s! ig_Width
	10 FemaleImage s! ig_Height
	 2 FemaleImage s! ig_Depth
	 0 FemaleImage s! ig_ImageData
	 3 FemaleImage s! ig_PlanePick
	 0 FemaleImage s! ig_PlaneOnOff
	 0 FemaleImage s! ig_NextImage

Gadget FemaleGadget

	134 FemaleGadget s! gg_LeftEdge
	 34 FemaleGadget s! gg_TopEdge
	 20 FemaleGadget s! gg_Width
	 10 FemaleGadget s! gg_Height
	GADGIMAGE GADGHCOMP |  FemaleGadget s! gg_Flags
	RELVERIFY GADGIMMEDIATE | TOGGLESELECT |  FemaleGadget s! gg_Activation
	BOOLGADGET FemaleGadget s! gg_GadgetType
	  0 FemaleGadget s! gg_SelectRender
	  0 FemaleGadget s! gg_GadgetText
	  0 FemaleGadget s! gg_MutualExclude
	  0 FemaleGadget s! gg_SpecialInfo
	  0 FemaleGadget s! gg_GadgetID
	  0 FemaleGadget s! gg_UserData

: Initialize11  ( -- )  Initialize10
	[ GADGIMAGE GADGHCOMP | ] literal  FemaleGadget s! gg_Flags
	PhonStrGadget FemaleGadget s! gg_NextGadget
	FemaleImage   FemaleGadget s! gg_GadgetRender
;



\ /* Male Toggle (Highlight Image)
\    (Quasi mutual Exclude with above) */

Image MaleImage

	 0 MaleImage s! ig_LeftEdge
	 0 MaleImage s! ig_TopEdge
	20 MaleImage s! ig_Width
	10 MaleImage s! ig_Height
	 2 MaleImage s! ig_Depth
	 0 MaleImage s! ig_ImageData
	 3 MaleImage s! ig_PlanePick
	 0 MaleImage s! ig_PlaneOnOff
	 0 MaleImage s! ig_NextImage

Gadget MaleGadget

	154 MaleGadget s! gg_LeftEdge
	 34 MaleGadget s! gg_TopEdge
	 20 MaleGadget s! gg_Width
	 10 MaleGadget s! gg_Height
	GADGIMAGE GADGHCOMP | SELECTED |  MaleGadget s! gg_Flags
	RELVERIFY GADGIMMEDIATE | TOGGLESELECT | ACTIVATE |  MaleGadget s! gg_Activation
	BOOLGADGET MaleGadget s! gg_GadgetType
	  0 MaleGadget s! gg_SelectRender
	  0 MaleGadget s! gg_GadgetText
	  0 MaleGadget s! gg_MutualExclude
	  0 MaleGadget s! gg_SpecialInfo
	  0 MaleGadget s! gg_GadgetID
	  0 MaleGadget s! gg_UserData

: Initialize12  ( -- )  Initialize11
	[ GADGIMAGE GADGHCOMP | SELECTED | ] literal   MaleGadget s! gg_Flags
	FemaleGadget  MaleGadget s! gg_NextGadget
	MaleImage     MaleGadget s! gg_GadgetRender
;






\ /* This boolean toggle gadget has an
\  * alternate image that indicates
\  * selection. The image stays flipped
\  * until it gets another hit. (it toggles)
\  */
\ /* Inflection Mode Toggle (AltImage) *************************/


Image HumanImage

	 0 HumanImage s! ig_LeftEdge
	 0 HumanImage s! ig_TopEdge
	40 HumanImage s! ig_Width
	20 HumanImage s! ig_Height
	 2 HumanImage s! ig_Depth
	 0 HumanImage s! ig_ImageData
	 3 HumanImage s! ig_PlanePick
	 0 HumanImage s! ig_PlaneOnOff
	 0 HumanImage s! ig_NextImage

Image RobotImage

	 0 RobotImage s! ig_LeftEdge
	 0 RobotImage s! ig_TopEdge
	40 RobotImage s! ig_Width
	20 RobotImage s! ig_Height
	 2 RobotImage s! ig_Depth
	 0 RobotImage s! ig_ImageData
	 3 RobotImage s! ig_PlanePick
	 0 RobotImage s! ig_PlaneOnOff
	 0 RobotImage s! ig_NextImage


Gadget ModeGadget

	134 ModeGadget s! gg_LeftEdge
	  2 ModeGadget s! gg_TopEdge
	 40 ModeGadget s! gg_Width
	 20 ModeGadget s! gg_Height
	GADGIMAGE GADGHIMAGE |  ModeGadget s! gg_Flags
	RELVERIFY GADGIMMEDIATE | TOGGLESELECT |  ModeGadget s! gg_Activation
	BOOLGADGET ModeGadget s! gg_GadgetType
	  0 ModeGadget s! gg_SelectRender
	  0 ModeGadget s! gg_GadgetText
	  0 ModeGadget s! gg_MutualExclude
	  0 ModeGadget s! gg_SpecialInfo
	  0 ModeGadget s! gg_GadgetID
	  0 ModeGadget s! gg_UserData

: Initialize13  ( -- )  Initialize12
	[ GADGIMAGE GADGHIMAGE | ] literal   ModeGadget s! gg_Flags
	MaleGadget    ModeGadget s! gg_NextGadget
	HumanImage    ModeGadget s! gg_GadgetRender
	RobotImage    ModeGadget s! gg_SelectRender
;



\ /* Face Toggle (image and text) ******************************/

IntuiText FaceIText

	BLKP FaceIText s! it_FrontPen
	GRYP FaceIText s! it_BackPen
	JAM2 FaceIText s! it_DrawMode
	   4 FaceIText s! it_LeftEdge
	   1 FaceIText s! it_TopEdge
	   0 FaceIText s! it_NextText

: Initialize14  ( -- )  Initialize13
	TestFont FaceIText s! it_ITextFont
	0" Face" FaceIText s! it_IText
;

Image FaceImage

	 0 FaceImage s! ig_LeftEdge
	 0 FaceImage s! ig_TopEdge
	40 FaceImage s! ig_Width
	10 FaceImage s! ig_Height
	 2 FaceImage s! ig_Depth
	 0 FaceImage s! ig_ImageData
	 3 FaceImage s! ig_PlanePick
	 0 FaceImage s! ig_PlaneOnOff
	 0 FaceImage s! ig_NextImage


Gadget FaceGadget

	         134 FaceGadget s! gg_LeftEdge
	          23 FaceGadget s! gg_TopEdge
	          40 FaceGadget s! gg_Width
	          10 FaceGadget s! gg_Height
	   GADGHCOMP GADGIMAGE |  FaceGadget s! gg_Flags
	   RELVERIFY GADGIMMEDIATE | TOGGLESELECT | FaceGadget s! gg_Activation
	   BOOLGADGET FaceGadget s! gg_GadgetType
	           0 FaceGadget s! gg_SelectRender
	           0 FaceGadget s! gg_MutualExclude
	           0 FaceGadget s! gg_GadgetID
	           0 FaceGadget s! gg_UserData

: Initialize14a  ( -- )  Initialize14
	ModeGadget    FaceGadget s! gg_Nextgadget
	FaceImage     FaceGadget s! gg_GadgetRender
	FaceIText     FaceGadget s! gg_GadgetText
;


IntuiText StopIText

	BLKP StopIText s! it_FrontPen
	GRYP StopIText s! it_BackPen
	JAM2 StopIText s! it_DrawMode
	   4 StopIText s! it_LeftEdge
	   1 StopIText s! it_TopEdge
	   0 StopIText s! it_NextText

: Initialize15  ( -- )  Initialize14a
	TestFont StopIText s! it_ITextFont
	0" Stop" StopIText s! it_IText
;

Image StopImage

	 0 StopImage s! ig_LeftEdge
	 0 StopImage s! ig_TopEdge
	40 StopImage s! ig_Width
	10 StopImage s! ig_Height
	 2 StopImage s! ig_Depth
	 0 StopImage s! ig_ImageData
	 3 StopImage s! ig_PlanePick
	 0 StopImage s! ig_PlaneOnOff
	 0 StopImage s! ig_NextImage

Gadget StopGadget

	134 StopGadget s! gg_LeftEdge
	 45 StopGadget s! gg_TopEdge
	 40 StopGadget s! gg_Width
	 10 StopGadget s! gg_Height
	GADGIMAGE GADGHCOMP |  StopGadget s! gg_Flags
	RELVERIFY GADGIMMEDIATE |   StopGadget s! gg_Activation
	BOOLGADGET StopGadget s! gg_GadgetType
	  0 StopGadget s! gg_SelectRender
	  0 StopGadget s! gg_MutualExclude
	  0 StopGadget s! gg_SpecialInfo
	  0 StopGadget s! gg_GadgetID
	  0 StopGadget s! gg_UserData

: Initialize16  ( -- )  Initialize15
	FaceGadget  StopGadget s! gg_NextGadget
	StopImage   StopGadget s! gg_GadgetRender
	StopIText   StopGadget s! gg_GadgetText
;






\ /* This is a hit (as opposed to toggle)
\    gadget that starts the translation.*/
\ /* Translate Hit (Highlight image) ***************************/
create TransVectorsLT[]
   0 w, 13 w,    0 w,  0 w,   79 w, 0 w,   78 w, 1 w,
   1 w,  1 w,    1 w, 12 w,
   
create TransVectorsBR[]
   1 w, 13 w,   79 w, 13 w,   79 w, 1 w,   78 w, 2 w,
  78 w, 12 w,    2 w, 12 w,
   

Border TransBorderLT

  -4 TransBorderLT s! bd_LeftEdge
  -3 TransBorderLT s! bd_TopEdge
WHTP TransBorderLT s! bd_FrontPen
GRYP TransBorderLT s! bd_BackPen
JAM1 TransBorderLT s! bd_DrawMode
   6 TransBorderLT s! bd_Count
   0 TransBorderLT s! bd_NextBorder

Border TransBorder

  -4 TransBorder s! bd_LeftEdge
  -3 TransBorder s! bd_TopEdge
BLKP TransBorder s! bd_FrontPen
GRYP TransBorder s! bd_BackPen
JAM1 TransBorder s! bd_DrawMode
   6 TransBorder s! bd_Count
   0 TransBorder s! bd_NextBorder

: Initialize17  ( -- )  Initialize16
  TransVectorsLT[]  TransBorderLT s! bd_XY
  TransVectorsBR[]  TransBorder   s! bd_XY
  0               TransBorderLT s! bd_NextBorder
  TransBorderLT   TransBorder   s! bd_NextBorder
;

IntuiText TranslateIText

	BLKP TranslateIText s! it_FrontPen
	GRYP TranslateIText s! it_BackPen
	JAM2 TranslateIText s! it_DrawMode
	   0 TranslateIText s! it_LeftEdge
	   0 TranslateIText s! it_TopEdge
	   0 TranslateIText s! it_NextText

: Initialize18  ( -- )  Initialize17
	TestFont TranslateIText s! it_ITextFont
	0" Translate" TranslateIText s! it_IText
;


Gadget TranslateGadget

	229 TranslateGadget s! gg_LeftEdge
	 48 TranslateGadget s! gg_TopEdge
	 71 TranslateGadget s! gg_Width
	  8 TranslateGadget s! gg_Height
	GADGHCOMP  TranslateGadget s! gg_Flags
	RELVERIFY GADGIMMEDIATE |   TranslateGadget s! gg_Activation
	BOOLGADGET TranslateGadget s! gg_GadgetType
	  0 TranslateGadget s! gg_SelectRender
	  0 TranslateGadget s! gg_MutualExclude
	  0 TranslateGadget s! gg_SpecialInfo
	  0 TranslateGadget s! gg_GadgetID
	  0 TranslateGadget s! gg_UserData

: Initialize19  ( -- )  Initialize18
	StopGadget     TranslateGadget s! gg_NextGadget
	TransBorder    TranslateGadget s! gg_GadgetRender
	TranslateIText TranslateGadget s! gg_GadgetText
;


\ /* This is a hit (as opposed to toggle) Starts the narration */
\ /* Speak Hit (Highlight Image) *******************************/
create SpeakVectorsLT[]
   0 w, 13 w,    0 w,  0 w,   47 w, 0 w,   46 w, 1 w,
   1 w,  1 w,    1 w, 12 w,
   
create SpeakVectorsBR[]
   1 w, 13 w,   47 w, 13 w,   47 w, 1 w,   46 w, 2 w,
  46 w, 12 w,    2 w, 12 w,
   

Border SpeakBorderLT

  -4 SpeakBorderLT s! bd_LeftEdge
  -3 SpeakBorderLT s! bd_TopEdge
WHTP SpeakBorderLT s! bd_FrontPen
GRYP SpeakBorderLT s! bd_BackPen
JAM1 SpeakBorderLT s! bd_DrawMode
   6 SpeakBorderLT s! bd_Count
   0 SpeakBorderLT s! bd_NextBorder

Border SpeakBorder

  -4 SpeakBorder s! bd_LeftEdge
  -3 SpeakBorder s! bd_TopEdge
BLKP SpeakBorder s! bd_FrontPen
GRYP SpeakBorder s! bd_BackPen
JAM1 SpeakBorder s! bd_DrawMode
   6 SpeakBorder s! bd_Count
   0 SpeakBorder s! bd_NextBorder

: Initialize20  ( -- )  Initialize19
  SpeakVectorsLT[]  SpeakBorderLT s! bd_XY
  SpeakVectorsBR[]  SpeakBorder   s! bd_XY
  0                 SpeakBorderLT s! bd_NextBorder
  SpeakBorderLT     SpeakBorder   s! bd_NextBorder
;


IntuiText SpeakIText

	BLKP SpeakIText s! it_FrontPen
	GRYP SpeakIText s! it_BackPen
	JAM2 SpeakIText s! it_DrawMode
	   0 SpeakIText s! it_LeftEdge
	   0 SpeakIText s! it_TopEdge
	   0 SpeakIText s! it_NextText

: Initialize21  ( -- )  Initialize20
	TestFont SpeakIText s! it_ITextFont
	0" Speak" SpeakIText s! it_IText
;



Gadget SpeakGadget

	261 SpeakGadget s! gg_LeftEdge
	 79 SpeakGadget s! gg_TopEdge
	 40 SpeakGadget s! gg_Width
	  8 SpeakGadget s! gg_Height
	GADGHCOMP  SpeakGadget s! gg_Flags
	RELVERIFY GADGIMMEDIATE |   SpeakGadget s! gg_Activation
	BOOLGADGET SpeakGadget s! gg_GadgetType
	  0 SpeakGadget s! gg_SelectRender
	  0 SpeakGadget s! gg_MutualExclude
	  0 SpeakGadget s! gg_SpecialInfo
	  0 SpeakGadget s! gg_GadgetID
	  0 SpeakGadget s! gg_UserData

: Initialize22  ( -- )  Initialize21
	TranslateGadget SpeakGadget s! gg_NextGadget
	SpeakBorder     SpeakGadget s! gg_GadgetRender
	SpeakIText      SpeakGadget s! gg_GadgetText
;


IntuiText LoopIText

	BLKP LoopIText s! it_FrontPen
	GRYP LoopIText s! it_BackPen
	JAM2 LoopIText s! it_DrawMode
	   4 LoopIText s! it_LeftEdge
	   0 LoopIText s! it_TopEdge
	   0 LoopIText s! it_NextText

Gadget LoopGadget

	208 LoopGadget s! gg_LeftEdge
	 79 LoopGadget s! gg_TopEdge
	 40 LoopGadget s! gg_Width
	  8 LoopGadget s! gg_Height
	GADGHCOMP  LoopGadget s! gg_Flags
	RELVERIFY GADGIMMEDIATE |  TOGGLESELECT | LoopGadget s! gg_Activation
	BOOLGADGET LoopGadget s! gg_GadgetType
	  0 LoopGadget s! gg_SelectRender
	  0 LoopGadget s! gg_MutualExclude
	  0 LoopGadget s! gg_SpecialInfo
	  0 LoopGadget s! gg_GadgetID
	  0 LoopGadget s! gg_UserData

: Initialize22a  ( -- )  Initialize22
	TestFont LoopIText s! it_ITextFont
	0" Loop" LoopIText s! it_IText
	SpeakGadget    LoopGadget s! gg_NextGadget
	SpeakBorder    LoopGadget s! gg_GadgetRender
	LoopIText      LoopGadget s! gg_GadgetText
;



\ /* Now the proportional gadgets. */
\ /* Proportional Gadgets **************************************/
\ /* The following variables are used to create proportional
\  * Gadgets. These variables will be filled in with copies of
\  * the generic Gadgetry below.
\  */
0 value PropCount  0 -> PropCount       \ /* index to next available Gadget */

create PTextsBase    \ /* get copies of TPropText */
NUMPROPS  sizeof() IntuiText * allot    here even-up dp !
PTextsBase  here PTextsBase -  cell- erase

: Ptexts   ( ix -- addr )
  sizeof() Intuitext *  PTextsBase +
;

\ IntuiText PTexts[NUMPROPS];    \ /* get copies of TPropText */


\ /* dummy AUTOKNOB Images are required */
create PImagesBase
NUMPROPS  sizeof() Image * allot    here even-up dp !
PImagesBase  here PImagesBase -  cell- erase

: PImages   ( ix -- addr )
  sizeof() Image *  PImagesBase +
;

\ struct Image PImages[NUMPROPS];

\ /* These get copies of TPropInfo */
create PInfosBase
NUMPROPS  sizeof() PropInfo * allot    here even-up dp !
PInfosBase  here PInfosBase -  cell- erase

: PInfos   ( ix -- addr )
  sizeof() PropInfo *  PInfosBase +
;

\ struct PropInfo PInfos[NUMPROPS];

\ /* These get copies of TPropGadget */
create PropsBase
NUMPROPS  sizeof() Gadget * allot    here even-up dp !
PropsBase  here PropsBase -  cell- erase

: Props   ( ix -- addr )
  sizeof() Gadget *  PropsBase +
;

\ struct Gadget Props[NUMPROPS];

IntuiText TPropText

	BLKP TPropText s! it_FrontPen
	GRYP TPropText s! it_BackPen
	JAM1 TPropText s! it_DrawMode
	   0 TPropText s! it_LeftEdge
	 -10 TPropText s! it_TopEdge
	   0 TPropText s! it_NextText
	   0 TPropText s! it_IText		\ set at runtime

: Initialize23  ( -- )  Initialize22a
	TestFont TPropText s! it_ITextFont
;


PropInfo TpropInfo

    AUTOKNOB FREEHORIZ |  TPropInfo s! pi_Flags	
         0 TPropInfo s! pi_HorizPot	
         0 TPropInfo s! pi_VertPot	
    $ 1fff TPropInfo s! pi_HorizBody		
    $ 1fff TPropInfo s! pi_VertBody		
         0 TPropInfo s! pi_CWidth	
         0 TPropInfo s! pi_CHeight	
         0 TPropInfo s! pi_HPotRes
         0 TPropInfo s! pi_VPotRes	
         0 TPropInfo s! pi_LeftBorder		
         0 TPropInfo s! pi_TopBorder		




\ /* this is the template for the Gadget of a horizontal */
\ /* Proportional Gadget */

Gadget TPropGadget

	           7 TPropGadget s! gg_LeftEdge
	          12 TPropGadget s! gg_TopEdge
	         115 TPropGadget s! gg_Width
	          10 TPropGadget s! gg_Height
GADGHCOMP GADGIMAGE     |  TPropGadget s! gg_Flags
GADGIMMEDIATE RELVERIFY |  TPropGadget s! gg_Activation
	  PROPGADGET TPropGadget s! gg_GadgetType
	           0 TPropGadget s! gg_GadgetRender
	           0 TPropGadget s! gg_SelectRender
	           0 TPropGadget s! gg_GadgetText
	           0 TPropGadget s! gg_MutualExclude
	           0 TPropGadget s! gg_SpecialInfo
	           0 TPropGadget s! gg_GadgetID
	           0 TPropGadget s! gg_UserData

: Initialize24  ( -- )  Initialize23
	LoopGadget	TPropGadget s! gg_NextGadget
;



\ JForth has special operators for opening libraries.  These
\ library pointers exist in JForth as INTUITION_LIB and
\ GRAPHICS_LIB, but are not normally necessary to reference,
\ except when actually compiling a call into that library...
\
\ struct IntuitionBase *IntuitionBase = 0;
\ struct GfxBase *GfxBase = 0;

\ /* Only one menu. */

0 value MenuNumber
0 value TheMenu
0 value TheItem

IntuiText MenuItemText

	GRYP MenuItemText s! it_FrontPen
	BLKP MenuItemText s! it_BackPen
	JAM2 MenuItemText s! it_DrawMode
	   0 MenuItemText s! it_LeftEdge
	   0 MenuItemText s! it_TopEdge
	   0 MenuItemText s! it_NextText

: Initialize25  ( -- )  Initialize24
	TestFont MenuItemText s! it_ITextFont
	0" About SpeechToy..." MenuItemText s! it_IText
;


MenuItem MyMenuItem

       0 MyMenuItem s! mi_NextItem	
       0 MyMenuItem s! mi_LeftEdge
       0 MyMenuItem s! mi_TopEdge	
     150 MyMenuItem s! mi_Width
       8 MyMenuItem s! mi_Height		
    ITEMTEXT ITEMENABLED | HIGHCOMP |  MyMenuItem s! mi_Flags		
       0 MyMenuItem s! mi_MutualExclude		
       0 MyMenuItem s! mi_ItemFill		
       0 MyMenuItem s! mi_SelectFill		
       0 MyMenuItem s! mi_Command		
       0 MyMenuItem s! mi_SubItem	
MENUNULL MyMenuItem s! mi_NextSelect

: Initialize26  ( -- )  Initialize25
	MenuItemText MyMenuItem s! mi_ItemFill
;

Menu Mymenu

       0 Mymenu s! mu_NextMenu	
       0 Mymenu s! mu_LeftEdge
       0 Mymenu s! mu_TopEdge	
     150 Mymenu s! mu_Width
       0 Mymenu s! mu_Height	
MENUENABLED Mymenu s! mu_Flags		
       0 Mymenu s! mu_MenuName		
       0 Mymenu s! mu_FirstItem
       0 Mymenu s! mu_JazzX
       0 Mymenu s! mu_JazzY
       0 Mymenu s! mu_BeatX
       0 Mymenu s! mu_BeatY

: Initialize27  ( -- )  Initialize26
	0" SpeachToy Menu" Mymenu s! mu_MenuName
            MyMenuItem Mymenu s! mu_FirstItem
;


IntuiText ReqText1

	GRYP ReqText1 s! it_FrontPen
	BLKP ReqText1 s! it_BackPen
	JAM2 ReqText1 s! it_DrawMode
	   5 ReqText1 s! it_LeftEdge
	  23 ReqText1 s! it_TopEdge
       0 ReqText1 s! it_ITextFont	
       0 ReqText1 s! it_IText		
	   0 ReqText1 s! it_NextText

: Initialize28  ( -- )  Initialize27
	TestFont ReqText1 s! it_ITextFont
	0" Version 1.1  21 Dec, 1985 - 1.2 (in JForth) 6 Apr, 1994" ReqText1 s! it_IText
;

IntuiText ReqText2

	GRYP ReqText2 s! it_FrontPen
	BLKP ReqText2 s! it_BackPen
	JAM2 ReqText2 s! it_DrawMode
	   5 ReqText2 s! it_LeftEdge
	  13 ReqText2 s! it_TopEdge
       0 ReqText2 s! it_ITextFont	
       0 ReqText2 s! it_IText		
	   0 ReqText2 s! it_NextText

: Initialize29  ( -- )  Initialize28
	TestFont ReqText2 s! it_ITextFont
    ReqText1 ReqText2 s! it_NextText
	0"                  Freeware - Public Domain " ReqText2 s! it_IText
;

IntuiText ReqText3

	GRYP ReqText3 s! it_FrontPen
	BLKP ReqText3 s! it_BackPen
	JAM2 ReqText3 s! it_DrawMode
	   5 ReqText3 s! it_LeftEdge
	   3 ReqText3 s! it_TopEdge
       0 ReqText3 s! it_ITextFont	
       0 ReqText3 s! it_IText		
	   0 ReqText3 s! it_NextText

: Initialize30  ( -- )  Initialize29
	TestFont ReqText3 s! it_ITextFont
    ReqText2 ReqText3 s! it_NextText
	0" Written by David M Lucas, ported to JForth by Mike Haas" ReqText3 s! it_IText
;

IntuiText OKIText

	GRYP OKIText s! it_FrontPen
	BLKP OKIText s! it_BackPen
	JAM2 OKIText s! it_DrawMode
	   6 OKIText s! it_LeftEdge
	   3 OKIText s! it_TopEdge
       0 OKIText s! it_ITextFont	
       0 OKIText s! it_IText		
	   0 OKIText s! it_NextText

: Initialize31  ( -- )  Initialize30
	TestFont OKIText s! it_ITextFont
	0" OK"   OKIText s! it_IText
;


0 value AboutRequester

0 value autoret
0 value ControlWindow   0 -> ControlWindow
0 value FaceWindow      0 -> FaceWindow
0 value MyIntuiMessage

NewWindow NewControlWindow

        0 NewControlWindow s! nw_LeftEdge
       11 NewControlWindow s! nw_TopEdge		
CONTWINDW NewControlWindow s! nw_Width
CONTWINDH NewControlWindow s! nw_Height			
       -1 NewControlWindow s! nw_DetailPen
       -1 NewControlWindow s! nw_BlockPen		
GADGETUP  CLOSEWINDOW | MENUPICK |  NewControlWindow s! nw_IDCMPFlags			
WINDOWDRAG  WINDOWDEPTH | WINDOWCLOSE |
   GIMMEZEROZERO | ACTIVATE |    NewControlWindow s! nw_Flags			
        0 NewControlWindow s! nw_FirstGadget
        0 NewControlWindow s! nw_CheckMark
        0 NewControlWindow s! nw_Title			
        0 NewControlWindow s! nw_Screen
        0 NewControlWindow s! nw_BitMap
       20 NewControlWindow s! nw_MinWidth
       20 NewControlWindow s! nw_MinHeight	
CONTWINDW NewControlWindow s! nw_MaxWidth
CONTWINDH NewControlWindow s! nw_MaxHeight	
WBENCHSCREEN NewControlWindow s! nw_Type

: Initialize32  ( -- )  Initialize31
	[ NUMPROPS 1- ] literal Props NewControlWindow s! nw_FirstGadget
	                0" SpeechToy (written in JForth!)" NewControlWindow s! nw_Title
;

NewWindow NewFaceWindow

CONTWINDW NewFaceWindow s! nw_LeftEdge
       11 NewFaceWindow s! nw_TopEdge		
FACEWINDW 2* NewFaceWindow s! nw_Width
FACEWINDH NewFaceWindow s! nw_Height			
       -1 NewFaceWindow s! nw_DetailPen
       -1 NewFaceWindow s! nw_BlockPen		
SIZEVERIFY  NEWSIZE |  MENUPICK |  NewFaceWindow s! nw_IDCMPFlags			
WINDOWDRAG  WINDOWDEPTH | WINDOWSIZING |
   SIZEBBOTTOM | GIMMEZEROZERO | ACTIVATE |    NewFaceWindow s! nw_Flags			
        0 NewFaceWindow s! nw_FirstGadget
        0 NewFaceWindow s! nw_CheckMark
        0 NewFaceWindow s! nw_Title			
        0 NewFaceWindow s! nw_Screen
        0 NewFaceWindow s! nw_BitMap
FACEWINDW NewFaceWindow s! nw_MinWidth
FACEWINDH NewFaceWindow s! nw_MinHeight	
      640 NewFaceWindow s! nw_MaxWidth
      200 NewFaceWindow s! nw_MaxHeight	
WBENCHSCREEN NewFaceWindow s! nw_Type

: Initialize33  ( -- )  Initialize32
	0" Face" NewFaceWindow s! nw_Title
;

' Initialize33 is Initialize


create FemaleIData[]
\ /*   ----      -  These nibbles matter to image. */
     $ 0000 w, $ 0000 w,
     $ 00F0 w, $ 1000 w,
     $ 0198 w, $ 1000 w,
     $ 030C w, $ 1000 w,
     $ 0198 w, $ 1000 w,
     $ 00F0 w, $ 1000 w,
     $ 0060 w, $ 1000 w,
     $ 01F8 w, $ 1000 w,
     $ 0060 w, $ 1000 w,
     $ ffff w, $ f000 w,

     $ ffff w, $ f000 w,
     $ 8000 w, $ 0000 w,
     $ 8000 w, $ 0000 w,
     $ 8000 w, $ 0000 w,
     $ 8000 w, $ 0000 w,
     $ 8000 w, $ 0000 w,
     $ 8000 w, $ 0000 w,
     $ 8000 w, $ 0000 w,
     $ 8000 w, $ 0000 w,
     $ 0000 w, $ 0000 w,
   
here FemaleIData[] - constant FemaleIData[]SIZE

create MaleIData[]
\ /*   ----      -  These nibbles matter to image. */
     $ 0000 w, $ 0000 w,
     $ 003E w, $ 1000 w,
     $ 000E w, $ 1000 w,
     $ 0036 w, $ 1000 w,
     $ 01E0 w, $ 1000 w,
     $ 0330 w, $ 1000 w,
     $ 0618 w, $ 1000 w,
     $ 0330 w, $ 1000 w,
     $ 01E0 w, $ 1000 w,
     $ ffff w, $ f000 w,
   
     $ ffff w, $ f000 w,
     $ 8000 w, $ 0000 w,
     $ 8000 w, $ 0000 w,
     $ 8000 w, $ 0000 w,
     $ 8000 w, $ 0000 w,
     $ 8000 w, $ 0000 w,
     $ 8000 w, $ 0000 w,
     $ 8000 w, $ 0000 w,
     $ 8000 w, $ 0000 w,
     $ 0000 w, $ 0000 w,
   
   
here MaleIData[] - constant MaleIData[]SIZE

create HumanIData[]
\ /*   ----       ----       --   These nibbles matter to image. */
     $ 0000 w,  $ 0000 w,  $ 0000 w,
     $ 0000 w,  $ 0000 w,  $ 0100 w,
     $ 0000 w,  $ 0000 w,  $ 0100 w,
     $ 0000 w,  $ 0000 w,  $ 0100 w,
     $ 0007 w,  $ 9E00 w,  $ 0100 w,
     $ 0001 w,  $ 8600 w,  $ 0100 w,
     $ 0000 w,  $ 0000 w,  $ 0100 w,
     $ 0000 w,  $ 0000 w,  $ 0100 w,
     $ 0000 w,  $ 2000 w,  $ 0100 w,
     $ 0000 w,  $ 1000 w,  $ 0100 w,
     $ 0000 w,  $ 0800 w,  $ 0100 w,
     $ 0000 w,  $ 7C00 w,  $ 0100 w,
     $ 0000 w,  $ 0000 w,  $ 0100 w,
     $ 0000 w,  $ 0000 w,  $ 0100 w,
     $ 0000 w,  $ 0000 w,  $ 0100 w,
     $ 0000 w,  $ 7800 w,  $ 0100 w,
     $ 0000 w,  $ 0000 w,  $ 0100 w,
     $ 0000 w,  $ 0000 w,  $ 0100 w,
     $ 0000 w,  $ 0000 w,  $ 0100 w,
     $ ffff w,  $ ffff w,  $ ff00 w,
   
     $ ffff w,  $ ffff w,  $ ff00 w,
     $ 8000 w,  $ 0000 w,  $ 0000 w,
     $ 8000 w,  $ 0000 w,  $ 0000 w,
     $ 8000 w,  $ 0000 w,  $ 0000 w,
     $ 8000 w,  $ 0000 w,  $ 0000 w,
     $ 8000 w,  $ 0000 w,  $ 0000 w,
     $ 8000 w,  $ 0000 w,  $ 0000 w,
     $ 8000 w,  $ 0000 w,  $ 0000 w,
     $ 8000 w,  $ 0000 w,  $ 0000 w,
     $ 8000 w,  $ 0000 w,  $ 0000 w,
     $ 8000 w,  $ 0000 w,  $ 0000 w,
     $ 8000 w,  $ 0000 w,  $ 0000 w,
     $ 8000 w,  $ 0000 w,  $ 0000 w,
     $ 8000 w,  $ 0000 w,  $ 0000 w,
     $ 8000 w,  $ 0000 w,  $ 0000 w,
     $ 8000 w,  $ 0000 w,  $ 0000 w,
     $ 8000 w,  $ 0000 w,  $ 0000 w,
     $ 8000 w,  $ 0000 w,  $ 0000 w,
     $ 8000 w,  $ 0000 w,  $ 0000 w,
     $ 0000 w,  $ 0000 w,  $ 0000 w,
   
here HumanIData[] - constant HumanIData[]SIZE

create RobotIData[]
\ /*   ----       ----       --   These nibbles matter to image. */
     $ 0000 w,  $ 0000 w,  $ 0000 w,
     $ 0000 w,  $ 0000 w,  $ 0100 w,
     $ 0000 w,  $ 0000 w,  $ 0100 w,
     $ 0000 w,  $ 0000 w,  $ 0100 w,
     $ 0007 w,  $ 9E00 w,  $ 0100 w,
     $ 0004 w,  $ 9200 w,  $ 0100 w,
     $ 0007 w,  $ 9E00 w,  $ 0100 w,
     $ 0000 w,  $ 0000 w,  $ 0100 w,
     $ 0000 w,  $ 0000 w,  $ 0100 w,
     $ 0000 w,  $ 0000 w,  $ 0100 w,
     $ 0000 w,  $ 0000 w,  $ 0100 w,
     $ 0000 w,  $ 0000 w,  $ 0100 w,
     $ 0000 w,  $ 0000 w,  $ 0100 w,
     $ 0001 w,  $ F800 w,  $ 0100 w,
     $ 0001 w,  $ 0800 w,  $ 0100 w,
     $ 0001 w,  $ F800 w,  $ 0100 w,
     $ 0000 w,  $ 0000 w,  $ 0100 w,
     $ 0000 w,  $ 0000 w,  $ 0100 w,
     $ 0000 w,  $ 0000 w,  $ 0100 w,
     $ ffff w,  $ ffff w,  $ ff00 w,
   
     $ ffff w,  $ ffff w,  $ ff00 w,
     $ 8000 w,  $ 0000 w,  $ 0000 w,
     $ 8000 w,  $ 0000 w,  $ 0000 w,
     $ 8000 w,  $ 0000 w,  $ 0000 w,
     $ 8000 w,  $ 0000 w,  $ 0000 w,
     $ 8000 w,  $ 0000 w,  $ 0000 w,
     $ 8000 w,  $ 0000 w,  $ 0000 w,
     $ 8000 w,  $ 0000 w,  $ 0000 w,
     $ 8000 w,  $ 0000 w,  $ 0000 w,
     $ 8000 w,  $ 0000 w,  $ 0000 w,
     $ 8000 w,  $ 0000 w,  $ 0000 w,
     $ 8000 w,  $ 0000 w,  $ 0000 w,
     $ 8000 w,  $ 0000 w,  $ 0000 w,
     $ 8000 w,  $ 0000 w,  $ 0000 w,
     $ 8000 w,  $ 0000 w,  $ 0000 w,
     $ 8000 w,  $ 0000 w,  $ 0000 w,
     $ 8000 w,  $ 0000 w,  $ 0000 w,
     $ 8000 w,  $ 0000 w,  $ 0000 w,
     $ 8000 w,  $ 0000 w,  $ 0000 w,
     $ 0000 w,  $ 0000 w,  $ 0000 w,
   
here RobotIData[] - constant RobotIData[]SIZE

create FaceIData[]
\ /*   ----       ----       --   These nibbles matter to image. */
     $ 0000 w,  $ 0000 w,  $ 0000 w,
     $ 0000 w,  $ 0000 w,  $ 0100 w,
     $ 0000 w,  $ 0000 w,  $ 0100 w,
     $ 0000 w,  $ 0000 w,  $ 0100 w,
     $ 0000 w,  $ 0000 w,  $ 0100 w,
     $ 0000 w,  $ 0000 w,  $ 0100 w,
     $ 0000 w,  $ 0000 w,  $ 0100 w,
     $ 0000 w,  $ 0000 w,  $ 0100 w,
     $ 0000 w,  $ 0000 w,  $ 0100 w,
     $ ffff w,  $ ffff w,  $ ff00 w,

     $ ffff w,  $ ffff w,  $ ff00 w,
     $ 8000 w,  $ 0000 w,  $ 0000 w,
     $ 8000 w,  $ 0000 w,  $ 0000 w,
     $ 8000 w,  $ 0000 w,  $ 0000 w,
     $ 8000 w,  $ 0000 w,  $ 0000 w,
     $ 8000 w,  $ 0000 w,  $ 0000 w,
     $ 8000 w,  $ 0000 w,  $ 0000 w,
     $ 8000 w,  $ 0000 w,  $ 0000 w,
     $ 8000 w,  $ 0000 w,  $ 0000 w,
     $ 0000 w,  $ 0000 w,  $ 0000 w,

here FaceIData[] - constant FaceIData[]SIZE

create StopIData[]
\ /*   ----       ----       --   These nibbles matter to image. */
     $ 0000 w,  $ 0000 w,  $ 0000 w,
     $ 0000 w,  $ 0000 w,  $ 0100 w,
     $ 0000 w,  $ 0000 w,  $ 0100 w,
     $ 0000 w,  $ 0000 w,  $ 0100 w,
     $ 0000 w,  $ 0000 w,  $ 0100 w,
     $ 0000 w,  $ 0000 w,  $ 0100 w,
     $ 0000 w,  $ 0000 w,  $ 0100 w,
     $ 0000 w,  $ 0000 w,  $ 0100 w,
     $ 0000 w,  $ 0000 w,  $ 0100 w,
     $ ffff w,  $ ffff w,  $ ff00 w,

     $ ffff w,  $ ffff w,  $ ff00 w,
     $ 8000 w,  $ 0000 w,  $ 0000 w,
     $ 8000 w,  $ 0000 w,  $ 0000 w,
     $ 8000 w,  $ 0000 w,  $ 0000 w,
     $ 8000 w,  $ 0000 w,  $ 0000 w,
     $ 8000 w,  $ 0000 w,  $ 0000 w,
     $ 8000 w,  $ 0000 w,  $ 0000 w,
     $ 8000 w,  $ 0000 w,  $ 0000 w,
     $ 8000 w,  $ 0000 w,  $ 0000 w,
     $ 0000 w,  $ 0000 w,  $ 0000 w,


   
here StopIData[] - constant StopIData[]SIZE

   
0 value FemaleIData_chip	0 -> FemaleIData_chip
0 value MaleIData_chip	0 -> MaleIData_chip
0 value HumanIData_chip	0 -> HumanIData_chip
0 value RobotIData_chip	0 -> RobotIData_chip
0 value FaceIData_chip	0 -> FaceIData_chip
0 value StopIData_chip	0 -> StopIData_chip

\ /** start of code ***************************/

defer menumessage
defer gadgetmessage
defer DrawFace
defer MyCleanup
defer InitImages
defer freeimages
defer DoSpeak

0 Value DoLoop
0 value Aborted

: main  { | signals MIClass MICode MIAddress -- }

   Initialize  0 -> DoLoop  0 -> Aborted

   \ /* let MyCleanup know these signals not allocated yet */
   
   -1 talk_port s! mp_SigBit
   -1 read_port s! mp_SigBit

   \ /* Open those libraries that the program uses directly */
   
   LIB_QUIT off  \ LIBRARY_VERSION LIBVersion !
   intuition?  intuition_lib @ 0=
   IF
[ exists? STDEBUG .if ]
      >newline ." Can't open the intuition library" cr
[ .then ]
      MyCleanup
      quit
   THEN

   LIB_QUIT off  \ LIBRARY_VERSION LIBVersion !
   graphics?  graphics_lib @ 0=
   IF
[ exists? STDEBUG .if ]
      >newline ." Can't open the graphics library" cr
[ .then ]
      MyCleanup
      quit
   THEN

   LIB_QUIT off  \ LIBRARY_VERSION LIBVersion !
   translator?  translator_lib @ 0=
   IF
[ exists? STDEBUG .if ]
      >newline ." Can't open the translator library" cr
[ .then ]
      MyCleanup
      quit
   THEN

   \ /* Open the device */
   voice_io sizeof() narrator_rb erase
   0" narrator.device" 0 voice_io 0  OpenDevice() dup -> NarratorOpenError
   IF
[ exists? STDEBUG .if ]
      >newline ." Can't open the narrator device" cr
[ .then ]
      MyCleanup
      quit
   THEN

   voice_io .. ndi_message s@ io_Device s@ lib_version -> NarratorVersion
   
\    /* This is where the proportional gadgets are set up, using
\     * the templates that were declared staticly.
\     */
   \ 'C' for loop init...
   0 -> PropCount
   BEGIN
      \
      \ C for loop test
      PropCount NUMPROPS <
   WHILE
      \
      \ C for loop body
      TPropText    PropCount PTexts  sizeof() Intuitext move
      TPropGadget  PropCount Props   sizeof() Gadget    move
      TPropInfo    PropCount PInfos  sizeof() PropInfo  move
      PropCount PTexts   PropCount Props s! gg_GadgetText
      PropCount PImages  PropCount Props s! gg_GadgetRender
      PropCount PInfos   PropCount Props s! gg_SpecialInfo
      PropCount
      CASE
         0 OF
            0" Sample Freq:"  PropCount PTexts s! it_IText
            [ DEFFREQ MAXFREQ = ] literal
            IF
               65535
            ELSE
               [ DEFFREQ MINFREQ -  16 <<  MAXFREQ MINFREQ - / ] literal
            THEN
            PropCount PInfos s! pi_HorizPot
         ENDOF
         1 OF
            0" Rate:"  PropCount PTexts s! it_IText
            PropCount Props s@ gg_TopEdge  22 +  PropCount Props s! gg_TopEdge
            PropCount 1- Props    PropCount Props s! gg_NextGadget
            [ DEFRATE MAXRATE = ] literal
            IF
               65535
            ELSE
               [ DEFRATE MINRATE -  16 <<  MAXRATE MINRATE - / ] literal
            THEN
            PropCount PInfos s! pi_HorizPot
         ENDOF
         2 OF
            0" Pitch:"  PropCount PTexts s! it_IText
            PropCount Props s@ gg_LeftEdge  183 +  PropCount Props s! gg_LeftEdge
            PropCount 1- Props    PropCount Props s! gg_NextGadget
            [ DEFPITCH MAXPITCH = ] literal
            IF
               65535
            ELSE
               [ DEFPITCH MINPITCH -  16 <<  MAXPITCH MINPITCH - / ] literal
            THEN
            PropCount PInfos s! pi_HorizPot
         ENDOF
         3 OF
            0" Volume:"  PropCount PTexts s! it_IText
            PropCount Props s@ gg_TopEdge  22 +  PropCount Props s! gg_TopEdge
            PropCount Props s@ gg_LeftEdge  183 +  PropCount Props s! gg_LeftEdge
            PropCount 1- Props    PropCount Props s! gg_NextGadget
            [ DEFVOL MAXVOL = ] literal
            IF
               65535
            ELSE
               [ DEFVOL MINVOL -  16 <<  MAXVOL MINVOL - / ] literal
            THEN
            PropCount PInfos s! pi_HorizPot
         ENDOF
      ENDCASE
      \
      \ C for loop iteration
      1 +-> PropCount
   REPEAT
\   
\  /* Now allocate memory accessable by the chips for images */
   InitImages false =
   IF
[ exists? STDEBUG .if ]
      >newline ." Couldn't Allocate Images in chip memory." cr
[ .then ]
      MyCleanup
      quit
   THEN
\   
\  /* Set up the write port, allocate the signal, */
\  /* and the message */
   NT_MSGPORT  talk_port .. mp_Node s! ln_Type
   0  talk_port s! mp_Flags
   -1 AllocSignal()  dup talk_port s! mp_SigBit  -1 =
   IF
[ exists? STDEBUG .if ]
      >newline ." Couldn't Allocate talk Signal bit" cr
[ .then ]
      MyCleanup
      quit
   THEN
\   
   0 FindTask()  talk_port s! mp_SigTask
   talk_port .. mp_MsgList  NewList()
\
\    /* Set up the read port, allocate the signal, */
\    /*  and the message */
   NT_MSGPORT  read_port .. mp_Node s! ln_Type
   0  read_port s! mp_Flags
   -1 AllocSignal()  dup read_port s! mp_SigBit  -1 =
   IF
[ exists? STDEBUG .if ]
      >newline ." Couldn't Allocate read Signal bit" cr
[ .then ]
      MyCleanup
      quit
   THEN
\   
   0 FindTask()  read_port s! mp_SigTask
   read_port .. mp_MsgList  NewList()
\ 
\  /* Set up the write channel information */
   0 audio_chan  voice_io s! ndi_ch_masks
   4 voice_io s! ndi_nm_masks
   0 voice_io s! ndi_mouths
   talk_port  voice_io .. ndi_message .. io_Message s! mn_ReplyPort
   CMD_WRITE  voice_io .. ndi_message s! io_Command
           0  voice_io .. ndi_message s! io_Offset
   PhonBuffer voice_io .. ndi_message s! io_Data
\  talk_port  voice_io .. ndi_message .. io_Message s! mn_ReplyPort
   sizeof() narrator_rb  voice_io .. ndi_message .. io_Message s! mn_Length
\
\  /* Set up the read channel information */
   voice_io   mouth_io .. mrb_voice   sizeof() narrator_rb  move
   NarratorVersion 37 >=
   IF
           0  mouth_io s! mrb_width
           0  mouth_io s! mrb_height
   ELSE
           0  mouth_io .. mrb_voice s! ndi_F0enthusiasm
           0  mouth_io .. mrb_voice s! ndi_F0perturb
   THEN
   read_port  mouth_io .. mrb_voice .. ndi_message .. io_Message s! mn_ReplyPort
    CMD_READ  mouth_io .. mrb_voice .. ndi_message s! io_Command
           0  mouth_io .. mrb_voice .. ndi_message s! io_Error
   FaceWindow 0=
   IF
      NewControlWindow OpenWindow()  dup -> ControlWindow 0=
      IF
[ exists? STDEBUG .if ]
         >newline ." Couldn't open the control window." cr
[ .then ]
         MyCleanup
         quit
      THEN
   THEN
\
\  /* fill background of window */
   ControlWindow s@ wd_RPort  GRYP   SetAPen()
   ControlWindow s@ wd_RPort  0 0  ControlWindow s@ wd_GZZWidth
      ControlWindow s@ wd_GZZWidth  RectFill()
   NUMPROPS 1- Props  ControlWindow  0    RefreshGadgets()

   ControlWindow MyMenu  SetMenuStrip()

\ /* !!! Ah, But what if FaceWindow's not been opened? */
   BEGIN
\       /* ever wait for a signal and process it */
\       /* wait lets the rest of the system run, */
\       /* this program sleeps */
      1  ControlWindow s@ wd_UserPort s@ mp_SigBit  <<
      FaceWindow
      IF
         1  FaceWindow    s@ wd_UserPort s@ mp_SigBit  <<  OR
      THEN
      1  voice_io .. ndi_message .. io_Message
                  s@ mn_ReplyPort s@ mp_SigBit      <<  OR
      1  mouth_io .. mrb_voice .. ndi_message .. io_Message
                  s@ mn_ReplyPort s@ mp_SigBit      <<  OR   Wait() -> signals
\
\     /* now check to see to what we owe the intrusion */
\
      1 ControlWindow s@ wd_UserPort s@ mp_SigBit <<   signals AND
      IF
\
\        /* Process the Intuition message */
         BEGIN
            ControlWindow s@ wd_UserPort GetMsg() dup -> MyIntuiMessage
         WHILE
\             /* Get all the needed info and give message back */
            MyIntuiMessage s@ im_Class -> MIClass
            
            MyIntuiMessage s@ im_Code -> MICode
            MyIntuiMessage s@ im_IAddress -> MIAddress
            MyIntuiMessage ReplyMsg()
\             /* Now, what was it you wanted? */
            MIClass
            CASE
               MENUPICK of
                  MICode ControlWindow menumessage
               endof
               GADGETUP of
                  MIAddress ControlWindow gadgetmessage
               endof
               CLOSEWINDOW of
                  BEGIN
                     ControlWindow s@ wd_UserPort GetMsg() dup -> MyIntuiMessage
                  WHILE
                     MyIntuiMessage ReplyMsg()
                  REPEAT
                  MyCleanUp
                  quit
               endof
[ exists? STDEBUG .if ]
               	>newline ." Unhandled Message Received." cr
[ .then ]
            ENDCASE
         REPEAT
      THEN
\       /* Woken by intuition for FaceWindow*/
      FaceWindow
      IF
         1 FaceWindow s@ wd_UserPort s@ mp_SigBit <<   signals AND
         IF
   \
   \        /* Process the Intuition message */
            BEGIN
               FaceWindow s@ wd_UserPort GetMsg() dup -> MyIntuiMessage
            WHILE
   \             /* Get all the needed info and give message back */
               MyIntuiMessage s@ im_Class
               CASE
                  SIZEVERIFY of
                     MyIntuiMessage ReplyMsg()
                  endof
                  MENUPICK of
                     MICode FaceWindow menumessage
                     MyIntuiMessage ReplyMsg()
                  endof
                  NEWSIZE of
                     DrawFace
                     MyIntuiMessage ReplyMsg()
                  endof
   [ exists? STDEBUG .if ]
                  	>newline ." Unhandled Message Received." cr
   [ .then ]
                     MyIntuiMessage ReplyMsg()
               ENDCASE
            REPEAT
         THEN
      THEN
\       /* A voice SendIO (Write) has completed */
      1  voice_io .. ndi_message .. io_Message
                  s@ mn_ReplyPort s@ mp_SigBit      <<   signals AND
      IF
\
\          /* Was it Sucessful? filter out the abort error */
         voice_io .. ndi_message s@ io_Error   -2 =
         IF
            0 voice_io .. ndi_message s! io_Error
         THEN
         voice_io .. ndi_message s@ io_Error
         IF
[ exists? STDEBUG .if ]
            >newline ." Narrator won't. ("
            voice_io .. ndi_message s@ io_Error 0 .r ascii ) emit cr
[ .then ]
\             /* flash this screen */
            ControlWindow s@ wd_WScreen  DisplayBeep()

\             /* let user see where phoneme string was bad. */
            ControlWIndow PhonStrGadget RemoveGadget() -> ii
\             /* move the cursor to the error char */
            voice_io .. ndi_message s@ io_Actual 1-  PhonInfo s! si_BufferPos
\             /* assure cursor (error point) is shown in gad. */
\             /* within 29 (number of chars shown) of front */
            voice_io .. ndi_message s@ io_Actual  29  <
            IF
               0  PhonInfo s! si_DispPos
            ELSE
\             /* within 29 of end */
               voice_io .. ndi_message s@ io_Length
               voice_io .. ndi_message s@ io_Actual  -  29  <
               IF
                  voice_io .. ndi_message s@ io_Length
                  PhonInfo s! si_DispPos
               ELSE
                  voice_io .. ndi_message s@ io_Actual  15 -
                  PhonInfo s! si_DispPos
               THEN
            THEN
            ControlWIndow PhonStrGadget ii AddGadget()
            PhonStrGadget ControlWIndow  0 RefreshGadgets()
            0 voice_io .. ndi_message s! io_Error
         THEN
\          SpeakGadget s@ gg_Flags  GADGDISABLED xor  SpeakGadget s! gg_Flags
\          FaceGadget  s@ gg_Flags  GADGDISABLED xor  FaceGadget  s! gg_Flags

         FaceWindow 0=
         IF
            DoLoop  Aborted 0= and
            IF
               DoSpeak
            THEN
            0 -> Aborted
         THEN
         DoLoop 0=
         IF
            SpeakGadget ControlWIndow  0 OnGadget()
            FaceGadget  ControlWIndow  0 OnGadget()
         THEN
      THEN
\       /* A mouth DoIO (Read) has completed */
      1  mouth_io .. mrb_voice .. ndi_message .. io_Message
                  s@ mn_ReplyPort s@ mp_SigBit      <<   signals AND
      IF
\ >newline voice_io .. ndi_message s@ io_Error  .
\ mouth_io .. mrb_voice .. ndi_message s@ io_Error  . cr
         FaceWindow s@ wd_WScreen .. sc_ViewPort  WaitBOVP()
         FaceWindow s@ wd_RPort  BLKP  SetAPen()
         FaceWindow s@ wd_RPort  0  EyesBottom  FaceWindow s@ wd_GZZWidth
              FaceWindow s@ wd_GZZHeight   RectFill()
\ >newline
\ ." mwm=" mouthWMult . ." mrb_w=" mouth_io s@ mrb_width .
\
         NarratorVersion 37 >=
         IF
            mouth_io s@ mrb_width
         ELSE
           mouth_io .. mrb_voice s@ ndi_F0enthusiasm
         THEN 
         MouthWMult 0=
         IF
            ( mouth_io s@ mrb_width )  2/
         ELSE
            ( mouth_io s@ mrb_width )  MouthWMult *
         THEN
\ dup ." lw=" . 
         -> LipWidth
\ ." mhm=" mouthHMult . ." mrb_h=" mouth_io s@ mrb_height .
         NarratorVersion 37 >=
         IF
            mouth_io s@ mrb_height
         ELSE
            mouth_io .. mrb_voice s@ ndi_F0perturb
         THEN 
         MouthHMult 0=
         IF
            ( mouth_io s@ mrb_height )  2/
         ELSE
            ( mouth_io s@ mrb_height )  MouthHMult *
         THEN
\ dup ." lh=" . cr
         -> LipHeight
         FaceWindow s@ wd_RPort  REDP  SetAPen()
         FaceWindow s@ wd_RPort
            XMouthCenter LipWidth -  YMouthCenter Move()
         FaceWindow s@ wd_RPort
            XMouthCenter  YMouthCenter LipHeight -  Draw()
         FaceWindow s@ wd_RPort
            XMouthCenter LipWidth +  YMouthCenter Draw()
         FaceWindow s@ wd_RPort
            XMouthCenter  YMouthCenter LipHeight +  Draw()
         FaceWindow s@ wd_RPort
            XMouthCenter LipWidth -  YMouthCenter Draw()
\          /* the narrator will give an error when the */
\          /* write has completed and I've tried to read */
\          /* so I stop trying when that happens */
         mouth_io .. mrb_voice .. ndi_message s@ io_Error   0=
         IF
            mouth_io SendIO()
         ELSE
            DoLoop  Aborted 0= and
            IF
               DoSpeak
            THEN
            0 -> Aborted
            DoLoop 0=
            IF
               SpeakGadget ControlWIndow  0 OnGadget()
               FaceGadget  ControlWIndow  0 OnGadget()
            THEN
         THEN
      THEN
      
   AGAIN
;

\ /* a MENUPICK has been received, this
\  * routine takes the appropriate action
\  */
: |menumessage|  { code ww -- }
   code MENUNUM()
   CASE
      0 of
         code ITEMNUM()
         CASE
            0 of
               ww  ReqText3  0  OKIText  0  0  526  47  AutoRequest()
            endof
         ENDCASE
      endof
   ENDCASE
;               ' |menumessage| is menumessage

: |DoSpeak|  ( -- )
   voice_io AbortIO()
   mouth_io AbortIO()
   0 -> Aborted
   SpeakGadget ControlWindow NULL  OffGadget()
   FaceGadget  ControlWindow NULL  OffGadget()
   PhonBuffer 0count nip  voice_io .. ndi_message s! io_Length
   voice_io SendIO()
   voice_io s@ ndi_mouths  1 =
   IF
      0  mouth_io .. mrb_voice .. ndi_message s! io_Error
      mouth_io  SendIO()
   THEN
; ' |DoSpeak| is DoSpeak

\ /* a GADGETUP has been received, this
\  * routine takes the appropriate action
\  */
: |gadgetmessage|  { address ww | PropRange -- }
   address ModeGadget =
   IF
      ModeGadget s@ gg_Flags  SELECTED and
      IF
         ROBOTICF0
      ELSE
         NATURALF0
      THEN
      voice_io s! ndi_mode
   ELSE
   address FaceGadget =
   IF
\       /* tell the write that reads will be forthcomming */
      FaceGadget s@ gg_Flags  SELECTED and
      IF
      	1 voice_io s! ndi_mouths
      	NewFaceWindow OpenWindow() dup -> FaceWindow 0=
      	IF
[ exists? STDEBUG .if ]
         	>newline ." Couldn't open the face window." cr
[ .then ]
            MyCleanUp
            quit
         THEN
         FaceWindow  MyMenu  SetMenuStrip()
         DrawFace
      ELSE   \ /* FaceGadget de-SELECTed */
         0  voice_io s! ndi_mouths
         FaceWindow s@ wd_LeftEdge  NewFaceWindow s! nw_LeftEdge
         FaceWindow s@ wd_TopEdge  NewFaceWindow s! nw_TopEdge
         FaceWindow s@ wd_Width  NewFaceWindow s! nw_Width
         FaceWindow s@ wd_Height  NewFaceWindow s! nw_Height
         FaceWindow  CloseWindow()
         0 -> FaceWIndow
      THEN
   ELSE
   address StopGadget =
   IF
      voice_io AbortIO()
      0 voice_io .. ndi_message s! io_Error
      0 mouth_io .. mrb_voice .. ndi_message s! io_Error
      SpeakGadget ControlWIndow  0 OnGadget()
      FaceGadget  ControlWIndow  0 OnGadget()
      true -> aborted
\    /* Since this program changes a flag that intuition expects
\     * only the user to change (SELECTED bit), this program has
\     * to remove, then change, then add this gadget. Then by
\     * passing the address of this gadget to RefreshGadgets(),
\     * only the gadgets from here to the start of the list will
\     * be refreshed, which minimizes the visible flash that
\     * RefreshGadgets() can introduce.
\     * If one of the two gadgets (female/male) is hit, toggle
\     * the selection of the other gadget (since the gadget hit
\     * was toggled by intuition when it was hit).
\     */
   ELSE
   address FemaleGadget =
   IF
      Femalegadget s@ gg_Flags  SELECTED and
      IF
         FEMALE
      ELSE
         MALE
      THEN
      voice_io s! ndi_sex
      ControlWindow MaleGadget  RemoveGadget() -> ii
      MaleGadget s@ gg_Flags SELECTED xor  MaleGadget s! gg_Flags
      ControlWindow MaleGadget  ii  AddGadget()
      MaleGadget  ControlWindow ii RefreshGadgets()
   ELSE
   address MaleGadget =
   IF  ( 5 )
      Malegadget s@ gg_Flags  SELECTED and
      IF
         MALE
      ELSE
         FEMALE
      THEN
      voice_io s! ndi_sex
      ControlWindow FemaleGadget  RemoveGadget() -> ii
      FemaleGadget s@ gg_Flags SELECTED xor  FemaleGadget s! gg_Flags
      ControlWindow FemaleGadget  ii  AddGadget()
      MaleGadget  ControlWindow ii RefreshGadgets()
   ELSE
\    /* Since the program changes the contents of the string
\     * gadgets' buffer and it's size, which is something else
\     * intuition doesn't expect a program (as opposed to the
\     * user) to do. The program must remove, then change, then
\     * add this gadget, and then by passing the address of this
\     * gadget to RefreshGadgets(), only the gadgets from here
\     * to the start of the list will be refreshed, which
\     * minimizes the visible flash that RefreshGadgets() can
\     * introduce.
\     */
   address TranslateGadget =
   IF
      ControlWindow PhonStrgadget  removeGadget() -> ii
      EnglBuffer  EnglInfo s@ si_NumChars
      PhonBuffer  PhonInfo s@ si_MaxChars  Translate() dup -> TranslatorError
      IF
[ exists? STDEBUG .if ]
         >newline ." Translator won't. ("
         TranslatorError 0 .r ascii ) emit cr
[ .then ]
\             /* flash this screen */
         ControlWindow s@ wd_WScreen  DisplayBeep()
      THEN
\       /* Hey! NumChars includes the terminating NULL. */
\       /* This must be done. */
      voice_io .. ndi_message s@ io_Length  1+  PhonInfo s! si_NumChars
      PhonInfo s@ si_DispPos  voice_io .. ndi_message s@ io_Length  >
      IF
         voice_io .. ndi_message s@ io_Length  PhonInfo s! si_DispPos
      THEN
      ControlWindow  PhonStrGadget  ii  AddGadget()
      PhonStrGadget ControlWindow  0  RefreshGadgets()
   ELSE
   address SpeakGadget =
   IF
      DoSpeak
   ELSE
   address LoopGadget =
   IF
      DoLoop  IF 0 ELSE -1 THEN  -> DoLoop
   ELSE
   address EnglStrGadget =   \  /* do nothing */
   IF
   ELSE
   address PhonStrGadget =   \  /* do nothing */
   IF
   ELSE
   address  0 Props  =
   IF
   
      RNGFREQ -> PropRange
      0 PInfos s@ pi_HorizPot 2/   PropRange *  15 >>  MINFREQ +
                                              voice_io s! ndi_sampfreq
[ exists? STDEBUG .if ]
         >newline ." Freq. = "
         voice_io s@ ndi_sampfreq 0 .r cr
[ .then ]
   ELSE
   address  1 Props  =
   IF
   
      RNGRATE -> PropRange
      1 PInfos s@ pi_HorizPot 2/   PropRange *  15 >>  MINRATE +
                                              voice_io s! ndi_rate
[ exists? STDEBUG .if ]
         >newline ." Rate  = "
         voice_io s@ ndi_rate 0 .r cr
[ .then ]
   ELSE
   address  2 Props  =
   IF
   
      RNGPITCH -> PropRange
      2 PInfos s@ pi_HorizPot 2/   PropRange *  15 >>  MINPITCH +
                                              voice_io s! ndi_pitch
[ exists? STDEBUG .if ]
         >newline ." Pitch = "
         voice_io s@ ndi_pitch 0 .r cr
[ .then ]
   ELSE
   address  3 Props  =
   IF
   
      RNGVOL -> PropRange
      3 PInfos s@ pi_HorizPot 2/   PropRange *  15 >>  MINVOL +
                                              voice_io s! ndi_volume
[ exists? STDEBUG .if ]
         >newline ." Vol.  = "
         voice_io s@ ndi_volume 0 .r cr
[ .then ]
   ELSE
[ exists? STDEBUG .if ]
      >newline ." Unhandled gadget up received!" cr
[ .then ]
   THEN THEN THEN THEN THEN THEN THEN
   THEN THEN THEN THEN THEN THEN THEN
;  ' |gadgetmessage| is gadgetmessage


\ /* This calculates variables used to draw the mouth
\  * and eyes, as well as redrawing the face.
\  * Proportionality makes it very wierd, but it's
\  * wierder if you don't use a GimmeZeroZero window
\  * and GZZWidth/GZZHeight.
\  */
: |DrawFace|   ( -- )
   FaceWindow s@ wd_GZZWidth 2/  -> XMouthCenter
\    /* set left edge of left eye */
   FaceWindow s@ wd_GZZWidth 2 >>  -> EyesLeft
\    /* multiplier for mouth width */
   FaceWindow s@ wd_GZZWidth
   
   6 >>  -> MouthWMult

   FaceWindow s@ wd_GZZHeight 2 >>
         FaceWindow s@ wd_GZZHeight 4 >> -   -> EyesTop
   
   EyesTop  FaceWindow s@ wd_GZZHeight 3 >>  + 1+  -> EyesBottom
   FaceWindow s@ wd_GZZHeight EyesBottom -  -> yaw
   yaw 2/ EyesBottom + -> YMouthCenter
   yaw 5 >> -> MouthHMult

\    /* Set pen to White */
   FaceWindow s@ wd_RPort  BLKP  SetAPen()
   FaceWindow s@ wd_RPort  0  0  FaceWindow s@ wd_GZZWidth
         FaceWindow s@ wd_GZZHeight   RectFill()

\    /* Set pen to Blue */
   FaceWindow s@ wd_RPort GRYP  SetAPen()
   
   FaceWindow s@ wd_RPort
    EyesLeft EyesTop
    EyesLeft  FaceWindow s@ wd_GZZWidth  3 >>  +
    EyesTop   FaceWindow s@ wd_GZZHeight 3 >>  +    RectFill()
    
   FaceWindow s@ wd_RPort
    FaceWindow s@ wd_GZZWidth 2/  FaceWindow s@ wd_GZZWidth 3 >>  +
    EyesTop
    FaceWindow s@ wd_GZZWidth 1 >>
          FaceWindow s@ wd_GZZWidth 3 >> +  \  /* two >> 3, not one >> 2 */
          FaceWindow s@ wd_GZZWidth 3 >> +  \  /* so eyes are same width */
    EyesTop  FaceWindow s@ wd_GZZHeight 3 >> +        RectFill()

   FaceWindow s@ wd_RPort  REDP   SetAPen()   \  /* Set pen to Red */
   
   FaceWindow s@ wd_RPort
    XMouthCenter  FaceWindow s@ wd_GZZWidth 3 >>   -
    YMouthCenter   Move()
    
   FaceWindow s@ wd_RPort
    XMouthCenter  FaceWindow s@ wd_GZZWidth 3 >>  +
    YMouthCenter  Draw()
; ' |DrawFace| is DrawFace


\ /* Deallocate any memory, and close all of the
\  * windows/screens/devices/libraries in reverse order to
\  * make things work smoothly. And be sure to check
\  * that the open/allocation was successful before
\  * closing/deallocating.
\  */
: |MyCleanup|  ( -- )
   read_port s@ mp_SigBit -1 -
   IF
      read_port s@ mp_SigBit  FreeSignal()
   THEN
   talk_port s@ mp_SigBit -1 -
   IF
      talk_port s@ mp_SigBit  FreeSignal()
   THEN
   FaceWindow
   IF
      FaceWindow CloseWindow()  0 -> FaceWIndow
   THEN
   ControlWindow
   IF
      ControlWindow CloseWindow()  0 -> ControlWindow
   THEN
\    /* freeimages makes sure image allocation was successful */
   freeimages
   NarratorOpenError 0=
   IF
      voice_io CloseDevice()
   THEN
   -Translator
   -graphics
   -intuition
; ' |MyCleanup| is MyCleanup


\ /* Allocate chip memory for gadget images, and set the
\  * pointers in the corresponding image structures to point
\  * to these images. This must be done because the program
\  * could be loaded into expansion memory (off the side of
\  * the box), which the custom chips cannot access.
\  * And images must be in chip ram (that's memory that the
\  * custom chips can access, the internal 512K).
\  */
: |InitImages|  { | result -- 0=fail }
\ {
\    /* the images were staticly initialized above main */
\    extern USHORT *FemaleIData_chip;
\    extern USHORT *MaleIData_chip;
\    extern USHORT *HumanIData_chip;
\    extern USHORT *RobotIData_chip;
\    extern USHORT *FaceIData_chip;
\    extern USHORT *StopIData_chip;
\    int i;
 
   0 -> result
   
\    /* Allocate them all, stop and return false on failure */
   FemaleIData[]SIZE MEMF_CHIP AllocMem() dup -> FemaleIData_chip 0= ?GOTO.ERROR
   MaleIData[]SIZE   MEMF_CHIP AllocMem() dup -> MaleIData_chip   0= ?GOTO.ERROR
   HumanIData[]SIZE  MEMF_CHIP AllocMem() dup -> HumanIData_chip  0= ?GOTO.ERROR
   RobotIData[]SIZE  MEMF_CHIP AllocMem() dup -> RobotIData_chip  0= ?GOTO.ERROR
   FaceIData[]SIZE   MEMF_CHIP AllocMem() dup -> FaceIData_chip   0= ?GOTO.ERROR
   StopIData[]SIZE   MEMF_CHIP AllocMem() dup -> StopIData_chip   0= ?GOTO.ERROR    
   true -> result
   
   FemaleIData[]  FemaleIData_chip  FemaleIData[]SIZE ( 20 )  move
   MaleIData[]    MaleIData_chip    MaleIData[]SIZE   ( 20 )  move
   HumanIData[]   HumanIData_chip   HumanIData[]SIZE  ( 60 )  move
   RobotIData[]   RobotIData_chip   RobotIData[]SIZE  ( 60 )  move
   FaceIData[]    FaceIData_chip    FaceIData[]SIZE   ( 30 )  move
   StopIData[]    StopIData_chip    StopIData[]SIZE   ( 30 )  move

   FemaleIData_chip FemaleImage s! ig_ImageData
   MaleIData_chip   MaleImage   s! ig_ImageData
   HumanIData_chip  HumanImage  s! ig_ImageData
   RobotIData_chip  RobotImage  s! ig_ImageData
   FaceIData_chip   FaceImage   s! ig_ImageData
   StopIData_chip   StopImage   s! ig_ImageData
error:
   result
; ' |initimages| is initimages


\ /* Deallocate the memory that was used for images,
\  * See initimages for more details.
\  */
: |freeimages| ( -- )
\ {
\    /* the images were staticly initialized above main */
\    extern USHORT *FemaleIData_chip;
\    extern USHORT *MaleIData_chip;
\    extern USHORT *HumanIData_chip;
\    extern USHORT *RobotIData_chip;
\    extern USHORT *FaceIData_chip;
\    extern USHORT *StopIData_chip;

\    /* Deallocate only if the pointer is really there. */
   RobotIData_chip
   IF
      RobotIData_chip RobotIData[]SIZE   FreeMem()
      0 -> RobotIData_chip
   THEN
   HumanIData_chip
   IF
      HumanIData_chip HumanIData[]SIZE   FreeMem()
      0 -> HumanIData_chip
   THEN
   MaleIData_chip
   IF
      MaleIData_chip MaleIData[]SIZE   FreeMem()
      0 -> MaleIData_chip
   THEN
   RobotIData_chip
   IF
      FemaleIData_chip FemaleIData[]SIZE   FreeMem()
      0 -> FemaleIData_chip
   THEN
   RobotIData_chip
   IF
      FaceIData_chip FaceIData[]SIZE   FreeMem()
      0 -> FaceIData_chip
   THEN
   RobotIData_chip
   IF
      StopIData_chip StopIData[]SIZE   FreeMem()
      0 -> StopIData_chip
   THEN
; ' |freeimages| is freeimages
